home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / Wirth / Kurven / Sierpinski.mod < prev    next >
Text File  |  1993-08-15  |  2KB  |  77 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       Sierpinski
  3.   :Author.        Kai Bolay
  4.   :Address.       Hoffmannstraße 168, 7250 Leonberg
  5.   :Phone.         07152/22135
  6.   :History.       v1.00 Initial
  7.   :Copyright.     PD
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.2d
  10.   :Contents.      Introducing: Sierpinski...
  11. ------------------------------------------------------------------------- *)
  12. MODULE Sierpinski;
  13.  
  14. FROM Dos         IMPORT Delay;
  15. FROM LineDrawing IMPORT SetXY, Line, width, height;
  16.  
  17. VAR i, h, x0, y0      : INTEGER;
  18.     ciapra [0BFE001H] : SET OF (s0, s1, s2, s3, s4, s5, lmb); (* Mouse *)
  19.  
  20. PROCEDURE A (k : INTEGER); FORWARD;
  21. PROCEDURE B (k : INTEGER); FORWARD;
  22. PROCEDURE C (k : INTEGER); FORWARD;
  23. PROCEDURE D (k : INTEGER); FORWARD;
  24.  
  25. PROCEDURE A (k : INTEGER);
  26.  
  27. BEGIN
  28.    IF k > 0 THEN
  29.       A (k-1); Line (7, h); B (k-1); Line (0, 2*h);
  30.       D (k-1); Line (1, h); A (k-1);
  31.    END; (* IF *)
  32. END A;
  33.  
  34.  
  35. PROCEDURE B (k : INTEGER);
  36.  
  37. BEGIN
  38.    IF k > 0 THEN
  39.       B (k-1); Line (5, h); C (k-1); Line (6, 2*h);
  40.       A (k-1); Line (7, h); B (k-1);
  41.    END; (* IF *)
  42. END B;
  43.  
  44.  
  45. PROCEDURE C (k : INTEGER);
  46.  
  47. BEGIN
  48.    IF k > 0 THEN
  49.       C (k-1); Line (3, h); D (k-1); Line (4, 2*h);
  50.       B (k-1); Line (5, h); C (k-1);
  51.    END; (* IF *)
  52. END C;
  53.  
  54.  
  55. PROCEDURE D (k : INTEGER);
  56.  
  57. BEGIN
  58.    IF k > 0 THEN
  59.       D (k-1); Line (1, h); A (k-1); Line (2, 2*h);
  60.       C (k-1); Line (3, h); D (k-1);
  61.    END; (* IF *)
  62. END D;
  63.  
  64. BEGIN
  65.    h := (height DIV 80) * 16;
  66.    x0 := width DIV 2; y0 := height DIV 2 + h;
  67.    FOR i := 1 TO 4 DO
  68.       x0 := x0 - h;
  69.       h := h DIV 2;
  70.       y0 := y0 + h;
  71.       SetXY (x0, y0);
  72.       A (i); Line (7, h); B (i); Line (5, h);
  73.       C (i); Line (3, h); D (i); Line (1, h);
  74.       WHILE lmb IN ciapra DO Delay (10); END;
  75.    END; (* FOR *)
  76. END Sierpinski.
  77.